Dr. Windows 3/dr win3.zip/dr win3/UTILITY1/MSWLGO35.ZIP/EXAMPLES/MATCH

Text File | 1993-04-12 | 3KB | 167 lines

;
; Function:
;
; Regular expression evaluator. Similar to Regular expressions in Unix
; Utilities
;
; To run:
;
; Load "match
; Call MATCH [pattern] [sentence]
; Outputs "True or "False
;
; "pattern" must be one of ? # ! & @ ^
;
; Example:
;
; MATCH [?b?] [abc] ; Outputs "True
;
TO MATCH!
IF EMPTYP :SEN [OP "FALSE]
IF NOT TRY.PRED [OP "FALSE]
MAKE :SPECIAL.VAR FIRST :SEN
OP MATCH BF :PAT BF :SEN
END

TO MATCH#
MAKE :SPECIAL.VAR []
OP #TEST #GATHER :SEN
END

TO #GATHER :SEN
IF EMPTYP :SEN [OP :SEN]
IF NOT TRY.PRED [OP :SEN]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OP #GATHER BF :SEN
END

TO #TEST :SEN
IF MATCH BF :PAT :SEN [OP "TRUE]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP #TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO #TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP #TEST :SEN
END

TO MATCH&
OP &TEST MATCH#
END

TO &TEST :TF
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP :TF
END

TO MATCH?
MAKE :SPECIAL.VAR []
IF EMPTYP :SEN [OP MATCH BF :PAT :SEN]
IF NOT TRY.PRED [OP MATCH BF :PAT :SEN]
MAKE :SPECIAL.VAR FIRST :SEN
IF MATCH BF :PAT BF :SEN [OP "TRUE]
MAKE :SPECIAL.VAR []
OP MATCH BF :PAT :SEN
END

TO MATCH@
MAKE :SPECIAL.VAR :SEN
OP @TEST []
END

TO @TEST :SEN
IF @TRY.PRED [IF MATCH BF :PAT :SEN [OP "TRUE]]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP @TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO @TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP @TEST :SEN
END

TO @TRY.PRED
IF LISTP :SPECIAL.PRED [OP MATCH :SPECIAL.PRED THING :SPECIAL.VAR]
OP RUN LIST :SPECIAL.PRED THING :SPECIAL.VAR
END

TO MATCH^
MAKE :SPECIAL.VAR []
OUTPUT ^TEST :SEN
END

TO ^TEST :SEN
IF MATCH BF :PAT :SEN [OUTPUT "TRUE]
IF EMPTYP :SEN [OUTPUT "FALSE]
IF NOT TRY.PRED [OUTPUT "FALSE]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OUTPUT ^TEST BF :SEN
END

TO ALWAYS :X
OP "TRUE
END

TO ANYOF :SEN
OP ANYOF1 :SEN :IN.LIST
END

TO ANYOF1 :SEN :PATS
IF EMPTYP :PATS [OP "FALSE]
IF MATCH FIRST :PATS :SEN [OP "TRUE]
OP ANYOF1 :SEN BF :PATS
END

TO IN :WORD
OP MEMBERP :WORD :IN.LIST
END

TO MATCH :PAT :SEN
LOCAL [SPECIAL.VAR SPECIAL.PRED SPECIAL.BUFFER IN.LIST]
IF OR WORDP :PAT WORDP :SEN [OP "FALSE]
IF EMPTYP :PAT [OP EMPTYP :SEN]
IF LISTP FIRST :PAT [OP SPECIAL FPUT "!: :PAT :SEN]
IF MEMBERP FIRST FIRST :PAT [? # ! & @ ^] [OP SPECIAL :PAT :SEN]
IF EMPTYP :SEN [OP "FALSE]
IF EQUALP FIRST :PAT FIRST :SEN [OP MATCH BF :PAT BF :SEN]
OP "FALSE
END

TO PARSE.SPECIAL :WORD :VAR
IF EMPTYP :WORD [OP LIST :VAR "ALWAYS]
IF EQUALP FIRST :WORD ": [OP LIST :VAR BF :WORD]
OP PARSE.SPECIAL BF :WORD WORD :VAR FIRST :WORD
END

TO QUOTED :THING
IF LISTP :THING [OP :THING]
OP WORD "" :THING
END

TO SET.IN
MAKE "IN.LIST FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SET.SPECIAL :LIST
MAKE "SPECIAL.VAR FIRST :LIST
MAKE "SPECIAL.PRED LAST :LIST
IF EMPTYP :SPECIAL.VAR [MAKE "SPECIAL.VAR "SPECIAL.BUFFER]
IF MEMBERP :SPECIAL.PRED [IN ANYOF] [SET.IN]
IF NOT EMPTYP :SPECIAL.PRED [STOP]
MAKE "SPECIAL.PRED FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SPECIAL :PAT :SEN
SET.SPECIAL PARSE.SPECIAL BF FIRST :PAT "
OP RUN FPUT WORD "MATCH FIRST FIRST :PAT []
END

TO TRY.PRED
IF LISTP :SPECIAL.PRED [OP MATCH :SPECIAL.PRED FIRST :SEN]
OP RUN LIST :SPECIAL.PRED QUOTED FIRST :SEN
END